home *** CD-ROM | disk | FTP | other *** search
/ Delphi Magazine Collection 2001 / Delphi Magazine Collection 20001 (2001).iso / DISKS / ISSUE13 / CONSTRUC / LISTMENU.DPR < prev    next >
Encoding:
Text File  |  1996-08-15  |  3.7 KB  |  159 lines
  1. library ListMenu;
  2. {$DEFINE HACK}
  3. uses
  4.   ShareMem, ExptIntf, ToolIntf, Menus, Forms, Dialogs, Classes,
  5.   SysUtils;
  6.  
  7. { EXPERT TYPE DEFINITION }
  8.  
  9. Type
  10.   TBListMenuExpert = class(TIExpert)
  11.   public
  12.     constructor Create; virtual;
  13.  
  14.     function GetStyle: TExpertStyle; override;
  15.     function GetIDString: String; override;
  16.     function GetName: String; override;
  17.     function GetAuthor: String; override;
  18.   end {TBListMenuExpert};
  19.  
  20. { EXPERT SUPPORT FUNCTION }
  21.  
  22. procedure HandleException;
  23. begin
  24.   if Assigned(ToolServices) then
  25.     ToolServices.RaiseException(ReleaseException)
  26.   { Aplication.Handle := ToolServices.GetParentHandle; }
  27. end {HandleException};
  28.  
  29. { EXPERT IMPLEMENTATION }
  30.  
  31. constructor TBListMenuExpert.Create;
  32. var Main: TIMainMenuIntf;
  33.     MenuItems: TIMenuItemIntf;
  34.     ToolsTools: TIMenuItemIntf;
  35.     Tools: TIMenuItemIntf;
  36. var i,j: Integer;
  37.     f: System.Text;
  38. begin
  39.   inherited Create;
  40.   if ToolServices <> nil then
  41.   try
  42.     Main := ToolServices.GetMainMenu;
  43.     if Main <> nil then { we've got the main menu }
  44.     try
  45.       MenuItems := Main.GetMenuItems;
  46.       if MenuItems <> nil then
  47.       try
  48.         System.Assign(f,'C:\MENU');
  49.         System.Rewrite(f);
  50.         writeln(f,MenuItems.GetName,' -',MenuItems.GetItemCount);
  51.         for i:=0 to Pred(MenuItems.GetItemCount) do
  52.         begin
  53.           Tools := MenuItems.GetItem(i);
  54.           if Tools <> nil then { we've got a sub-menu }
  55.           try
  56.             writeln(f,'  ',Tools.GetName);
  57.           {$IFDEF HACK}
  58.             Tools.SetCaption(Format('menu%d',[i]));
  59.           {$ENDIF}
  60.             for j:=0 to Pred(Tools.GetItemCount) do
  61.             begin
  62.               ToolsTools := Tools.GetItem(j);
  63.               if ToolsTools <> nil then { sub-sub-menu }
  64.               try
  65.                 writeln(f,'    ',ToolsTools.GetName);
  66.               {$IFDEF HACK}
  67.                 ToolsTools.SetCaption(Format('submenu%d.%d',[i,j]));
  68.               {$ENDIF}
  69.               finally
  70.               {$IFNDEF HACK}
  71.                 ToolsTools.DestroyMenuItem
  72.               {$ENDIF}
  73.               end
  74.             end
  75.           finally
  76.           {$IFNDEF HACK}
  77.             Tools.DestroyMenuItem
  78.           {$ENDIF}
  79.           end
  80.         end
  81.       finally
  82.         System.Close(f);
  83.         MenuItems.DestroyMenuItem
  84.       end
  85.     finally
  86.       Main.Free
  87.     end
  88.   except
  89.     HandleException
  90.   end
  91. end {Create};
  92.  
  93. function TBListMenuExpert.GetStyle: TExpertStyle;
  94. begin
  95.   try
  96.     Result := esAddIn
  97.   except
  98.     HandleException
  99.   end
  100. end {GetStyle};
  101.  
  102. function TBListMenuExpert.GetIDString: String;
  103. begin
  104.   try
  105.     Result := 'DrBob.ListMenu.Expert'
  106.   except
  107.     HandleException
  108.   end
  109. end {GetIDString};
  110.  
  111. function TBListMenuExpert.GetName: String;
  112. begin
  113.   try
  114.     Result := 'DrBob.ListMenu.Expert'
  115.   except
  116.     HandleException
  117.   end
  118. end {GetName};
  119.  
  120. function TBListMenuExpert.GetAuthor: String;
  121. begin
  122.   try
  123.     Result := 'Bob.Swart'
  124.   except
  125.     HandleException
  126.   end
  127. end {GetAuthor};
  128.  
  129.  
  130. { DLL EXPERT INTERFACE }
  131.  
  132. procedure DoneExpert;
  133. begin
  134. { ShowMessage(ParamStr(0)+' unloaded!') }
  135. end {DoneExpert};
  136.  
  137. function InitExpert(ToolServices: TIToolServices;
  138.                     RegisterProc: TExpertRegisterProc;
  139.                 var Terminate: TExpertTerminateProc): Boolean; stdcall;
  140. begin
  141.   try
  142.     Result := True;
  143.     ExptIntf.ToolServices := ToolServices; { Save! }
  144.     if ToolServices <> nil then
  145.       Application.Handle := ToolServices.GetParentHandle;
  146.     Terminate := DoneExpert;
  147.     Result := RegisterProc(TBListMenuExpert.Create);
  148.   except
  149.     HandleException
  150.   end
  151. end {InitExpert};
  152.  
  153. exports
  154.   InitExpert name ExpertEntryPoint;
  155.  
  156. begin
  157. { ShowMessage(ParamStr(0)+' loaded!') }
  158. end.
  159.